perm filename SP4NS.F4[1,MUS] blob
sn#007304 filedate 1972-07-16 generic text, type T, neo UTF8
00100 SUBROUTINE SPACE4(AMP,RAMP,DOP,CHNA,CHNB,CHNC,CHND,ARRAY)
00200 DIMENSION AMP(512),RAMP(512),DOP(512),
00300 1 CHNA(512),CHNB(512),CHNC(512),CHND(512)
00400 DIMENSION ARRAY(2,513),B(4)
00450 DATA (B(I),I=1,3)/'SP4 FUNCS FULL'/
00500 CALL RDNUM(DIS)
00600 DELTA=DIS/100.0
00700 CALL RDNUM(XNUM)
00800 L=XNUM
00900 GO TO (1,2),L
01000 2 ZT=180./512.
01100 ZK=-ZT
01200 PI=1.+(2/3.14159)
01300 XX=0
01400 CALL RDNUM(XCO1)
01500 CALL RDNUM(YCO1)
01600 CALL RDNUM(XCO2)
01700 CALL RDNUM(YCO2)
01800 XCOI=(XCO2-XCO1)/512.0
01900 YCOI=(YCO2-YCO1)/512.0
02000 IL=1
02100 36 CONTINUE
02200 XX=ZK+ZT
02300 ZK=XX
02400 ARRAY(1,IL)=XCO1+(XCOI*SIND(XX)*PI)
02500 ARRAY(2,IL)=YCO1+(YCOI*SIND(XX)*PI)
02600 XCO1=ARRAY(1,IL)
02700 YCO1=ARRAY(2,IL)
02800 GO TO 520
02900 1 CALL RDNUM(XCO1)
03000 CALL RDNUM(YCO1)
03100 CALL RDNUM(FREQX)
03200 CALL RDNUM(PHASX)
03300 CALL RDNUM(FREQY)
03400 CALL RDNUM(PHASY)
03500 CALL RDNUM(FREQ2X)
03600 CALL RDNUM(PHAS2X)
03700 CALL RDNUM(FREQ2Y)
03800 CALL RDNUM(PHAS2Y)
03900 CALL RDNUM(DIA)
04000 CALL RDNUM(DIA2)
04100 XINC=(FREQX*360.)/512.
04200 XINC2=(FREQ2X*360.)/512.
04300 XK=-XINC+PHASX
04400 XK2=-XINC2+PHAS2X
04500 YINC=(FREQY*360.)/512.
04600 YINC2=(FREQ2Y*360.)/512.
04700 YK=-YINC+PHASY
04800 YK2=-YINC2+PHAS2Y
04900 IL=1
05000 37 CONTINUE
05100 XX=XK+XINC
05200 XX2=XK2+XINC2
05300 IF(XX.GE.360.)XX=XX-360.
05400 IF(XX2.GE.360.)XX2=XX2-360.
05500 XK=XX
05600 XK2=XX2
05700 YY=YK+YINC
05800 YY2=YK2+YINC2
05900 IF(YY.GE.360.)YY=YY-360.
06000 IF(YY2.GE.360.)YY2=YY2-360.
06100 YK=YY
06200 YK2=YY2
06300 ARRAY(1,IL)=XCO1+SIND(XX)*DIA+(SIND(XX2)*DIA2)
06400 ARRAY(2,IL)=YCO1+SIND(YY)*DIA+(SIND(YY2)*DIA2)
06500 520 CONTINUE
06600 IL=IL+1
06700 IF(IL.GT.512)GO TO 500
06800 GO TO (37,36),L
06900 500 CONTINUE
07000 M=512
07100 CALL RDNUM(SPD1)
07200 SPD1=60.0/((1.0/SPD1)*512.0)
07300 501 X=M-1
07400 AI=X/512.0
07500 BI=2.0
07600 S=60.0/SPD1
07700 R=SQRT(ARRAY(1,1)**2+ARRAY(2,1)**2)
07800 DO 100 J=1,512
07900 I=BI
08000 X=ARRAY(1,I)
08100 Y=ARRAY(2,I)
08200 BI=BI+AI
08300 R1=SQRT(X**2+Y**2)
08400 AMP(J)=(DIS/(R1*DELTA))**2
08500 C RAMP(J)=ALOG(DIS)/ALOG(R1*DELTA)
08550 RAMP(J)=DIS/(R1*DELTA)
08600 IF(RAMP(J).GT.1.)RAMP(J)=1.
08700 CONTINUE
08800 VR=S*DELTA*(R1-R)
08900 XJ=J
09000 IF((R1.EQ.R).AND.(XJ.GT.1.0))GO TO 31
09100 DOP(J)=1180.0/(1180.0+VR)
09200 GO TO 21
09300 31 DOP(J)=DOP(J-1)
09400 21 R=R1
09500 CONTINUE
09600 AX=ABS(X)
09700 AY=ABS(Y)
09800 PI=3.1416
09900 ANGLE=AMOD(ATAN2(Y,X)+6.2832,6.2832)
10000 PI2=PI/2.0
10100 IF((AX.LE.AY).AND.(Y.GT.0.0))GO TO 2000
10200 IF((AX.GT.AY).AND.(X.GT.0.0))GO TO 2001
10300 IF((AX.LE.AY).AND.(Y.LT.0.0))GO TO 2002
10400 CHN=ANGLE-(3.*PI)/4.
10500 CHNB(J)=1.-CHN/PI2
10600 CHNC(J)=CHN/PI2
10700 CHNA(J)=0.0
10800 CHND(J)=0.0
10900 GO TO 100
11000 2000 CHN=ANGLE-PI/4.
11100 CHNA(J)=1.-CHN/PI2
11200 CHNB(J)=CHN/PI2
11300 CHNC(J)=0.0
11400 CHND(J)=0.0
11500 GO TO 100
11600 2001 CHN=ANGLE-(7.*PI)/4.
11700 IF(ANGLE.LT.PI/4.)CHN=ANGLE+PI/4.
11800 CHND(J)=1.-CHN/PI2
11900 CHNA(J)=CHN/PI2
12000 CHNB(J)=0.0
12100 CHNC(J)=0.0
12200 GO TO 100
12300 2002 CHN=ANGLE-(5.*PI)/4.
12400 CHNC(J)=1.-CHN/PI2
12500 CHND(J)=CHN/PI2
12600 CHNA(J)=0.0
12700 CHNB(J)=0.0
12800 100 CONTINUE
12900 DO 402 JK=1,512
13000 CHNA(JK)=SQRT(CHNA(JK))
13100 CHNB(JK)=SQRT(CHNB(JK))
13200 CHNC(JK)=SQRT(CHNC(JK))
13300 CHND(JK)=SQRT(CHND(JK))
13400 402 CONTINUE
13500 CALL INTERP(AMP)
13600 CALL INTERP(RAMP)
13700 CALL INTERP(DOP)
13800 C CALL INTERP(CHNA)
13900 C CALL INTERP(CHNB)
14000 C CALL INTERP(CHNC)
14100 C CALL INTERP(CHND)
14150 CALL MESS(B)
14200 RETURN
14300 END
14400 CC******WAVE SMOOTHER********************************************
14500 SUBROUTINE INTERP(CFUNC)
14600 DIMENSION CFUNC(512)
14700 JT=0
14800 DO 601 KT=2,512
14900 IF(CFUNC(KT-1).NE.CFUNC(KT))GO TO 600
15000 IF(JT.EQ.0)JT=KT-1
15100 GO TO 601
15200 600 IF(JT.EQ.0)GO TO 601
15300 DIFF=CFUNC(KT)-CFUNC(JT)
15400 DIV=KT-JT
15500 ANS=DIFF/DIV
15600 DO 602 LM=JT+1,KT-1
15700 602 CFUNC(LM)=CFUNC(LM-1)+ANS
15800 JT=0
15900 601 CONTINUE
16000 RETURN
16100 END